Top 10k strings from HiSoft Pascal 4 +3 (1988)(HiSoft).dsk
in <root> / bin / z80 / software / Sinclair Spectrum Collection TOSEC.exe / Sinclair ZX Spectrum - Utilities & Educational / Sinclair ZX Spectrum - Utilities & Educational - [DSK] (TOSEC-v2007-01-01) /
Back to the directory listing
30 Track-Info 8 END; 8 END; 7 VAR i:INTEGER; 7 END 6 BEGIN 5 END; 5 END; 4 CASE i OF 4 BEGIN 4 rb:=PEEK(ADDR(F)+6,CHAR); 3 Drive not found 3 Bad parameter 3 Bad filename 3 6.#6P#6A#6S# 3 LD C,(HL) 3 CASE typ OF 3 END; 3 BEGIN 3 1:WRITE(gfile,'DE'); 3 0:WRITE(gfile,'BC'); 3 END; 3 ELSE 3 BEGIN 3 WRITE(gfile,','); 2 `iF#N#^#V`i 2 X catalogue 2 VAR r1:rec; i,j:INTEGER; dum:BOOLEAN; 2 Trash file(s) 2 The default is P-. 2 Read-only file 2 PROCEDURE qq(i:INTEGER); 2 PROCEDURE SPOUT(C:CHAR); 2 PROCEDURE CLOSE(VAR F:TEXT); 2 M:HPTMP.PAS 2 HPL 2 HP 2 File too big 2 File number not open 2 File not fo 2 File loaded from tape. 2 File already exists 2 FUNCTION upper(c:CHAR):CHAR; 2 Extent missing 2 Error, unknown 2 End of file 2 Drive in use 2 Disk not bootable 2 Directory full 2 DIS PAS 2 Cannot rename between drives 2 All rights reserved 2 Access denied 2 (C) HiSoft 1988 2 cx:=cx+1; 2 WRITE(gfile,i:4:H) 2 WRITE(gfile,')') 2 WRITE(gfile,'('); 2 WITH r DO 2 SPOUT(CHR(20));SPOUT(CHR( PENSTATUS));SPOUT(CHR(21) );SPOUT(CHR(PENSTATUS)); 2 RESET(dfile,fname); 2 P- means output to the screen 2 IF indexed THEN cx:=cx+1; 2 IF c IN ['a'..'z'] THEN c:=CHR(ORD(c)-ORD('a')+ORD('A')); 2 IF (C>=0) AND (C<8) THEN 2 FirstPass; 2 CASE bot OF 2 ,<>;=[]}{ 2 IF f^ IN ['a'..'f'] THEN i:=ORD(f^)-ORD('a')+10 ELSE 2 FOR i:=cur TO cur+bytesperline-1 DO 2 high,low:INTEGER; { The upper and lower parts of the current prime} 2 END 2 6:BEGIN 2 4:BEGIN 2 2:gX; 2 1:IF ODD(top) THEN 2 rhl:=adr; 2 rde:=nbytes; 2 dum:=READRAND(f,j,ADDR(r1),rsize); 2 USERF(#136); (* DOS set Position *) 2 END 2 ConvertRec(LOGREC,nbytes); 2 END 2 reg(top) 2 nn 2 n 2 cc(top); 2 WRITE(gfile,'LD '); 2 CASE top2 OF 2 3:CASE top OF 2 0:nn1; 1 }p#q#w#s#r 1 }F#N#^#~#fo 1 {writes a hexadecimal & ASCII dump of memory 1 {Reads a hex number from the file f} 1 {Finds the number of the last record in the file starting 1 {$O- is used so that e.g. #7F80+#99 does not give overflow} 1 {$F RANDREC } 1 { This program is a small example of the use of the random access facilities 1 { This file contains procedures and functions for Random Access Disc Files: 1 { Sets the re and rhl variables ready for DOS SET POSITION } 1 { R command retrives the info from a .DIS file - useful if 1 { P command saves the address and data informat.fin+1; 1 { K command - removes data area i where i is as given by the D command } 1 { G command - Generates a .GEN file of disaassembly } 1 { D command - displays the current data areas } 1 { (C) Copyright David Nutkins 1984. 1 { Initialise} 1 um:=READRAND(f,i,ADDR(r1),rsize); 1 t(Track-Info 1 q#p#s#r#"xb 1 please note the following manual misprints: 1 pe must be scalar 1 nS{kRJjX`kZjkPardon? 1 mPimRgqS jT)rV 1 lZ`mPardon? 1 kgo"Sp"Up>Y2 1 kM:HPM:HPE 1 j^#V###~= 1 j#N#F#^#V# 1 for the ZX Spectrum Plus 3 1 file from tape, then the P 1 fExponent Expected 1 fDelete text(Y/N) 1 estart,CHAR)):2:H) 1 e are 4 sorts of data areas that may be specified: 1 dDelete text(Y/N) 1 current Values 1 command to save file to disk. 1 comma expected 1 colon expecteB 1 cHiSoft Pascal Compiler 1 c! rc:=CHR(0); 1 [tb"tbs#r# 1 XT;LOGREC,adr,nbytes:INTEGER):BOOLEAN; 1 Wrong type combination 1 Write Error 1 Would you like 51 columns? 1 Variable in WITH must be RECORD type 1 Variable expected in READ 1 Variable expected as parameter 1 Variable expected after 'WITH' 1 VAR runstart,codestart,finish,size:INTEGER; 1 VAR res,i:INTEGER; 1 VAR r1:rec; s:name;i:INTEGER; dum:BOOLEAN; 1 VAR off:INTEGER; 1 VAR maxcx,enddef:INTEGER; 1 VAR lo,hi:INTEGER; 1 VAR lo,hi,junk:INTEGER; f:flag; 1 VAR i:INTEGER; dum:BOOLEAN; 1 VAR i,secondfin:INTEGER; 1 VAR i,j:INTEGER;cur:datarec; 1 VAR i,j:INTEGER; 1 VAR i,cur:INTEGER; 1 VAR dum:BOOLEAN; 1 VAR Sieve:ARRAY [0..w] OF SET OF 0..249;{Sieve in which the primes are contained} 1 VAR SGNX,SGNY:INTEGER; 1 VAR NEWX,NEWY:REAL; 1 VAR I:INTEGER; 1 VAR ByteNo:REAL; 1 Use the G command to load 1 Use P1,9999,name to save. 1 Unsigned integer expected after LABEL 1 Unsigned integer expected after GOTO 1 Undeclared label 1 Undeclared identifier 1 UNTIL upper(com)='E' 1 UNTIL i=-1; 1 UNTIL cx>secondfin 1 Type INTEGER or REAL expected 1 Too many ':'s. Only e:m:h valid 1 This proc/func only on textfiles 1 This identifier can't begin a statement 1 The full commands are: 1 Text starts: 1 Text ends: 1 Tape Error 1 TYPE flag=(B,W,S,M)r type identifier 1 TURTLE PAS 1 System Call Error 1 Symbol Table Full 1 Strings can't have EOLNs 1 Spectrum +3 version 29 Jan 88 1 Sorry, can't find error 1 Sets incompatible 1 Set too large ( >256 elements ) 1 Semi-colon or END expected before here 1 Scalar expression expected 1 Scalar (not real) expected 1 Scalar (including real) expected 1 SIZE takes variable o. 1 Runtime Error 1 Read me file for HiSoft Pascal +3 1 RESET, REWRITE invalid on INPUT, OUTPUT 1 READ ME 1 RANDREC PAS 1 Put to disk 1 Parameter type must be type identifier 1 Parameter should be of FILE type 1 Parameter must be a POINTER variable 1 Page 86 Omit reference to READR and WRITER. 1 Page 50: The P option should be followed by + or - 1 PROGRAM disassembler; 1 PROGRAM birthday; 1 PROCEDURE typ3; 1 PROCEDURE typ2; 1 PROCEDURE typ1; 1 PROCEDURE typ0; 1 PROCEDURE reg(no:INTEGER); 1 PROCEDURE r1; 1 PROCEDURE pass1byte; 1 PROCEDURE oneDEFW; 1 PROCEDURE nn; 1 PROCEDURE nn1; 1 PROCEDURE n; 1 PROCEDURE getfname; 1 PROCEDURE getch; 1 PROCEDURE getbits; 1 PROCEDURE gX; 1 PROCEDURE extdis; 1 PROCEDURE enter(adr:INTEGER); 1 PROCEDURE ed; 1 PROCEDURE e; 1 PROCEDURE dodata; 1 PROCEDURE defmod; 1 PROCEDURE dd(i:INTEGER); 1 PROCEDURE cc(i:INTEGER); 1 PROCEDURE cb; 1 PROCEDURE byte; 1 PROCEDURE bnn; 1 PROCEDURE addop(a:INTEGER); 1 PROCEDURE Xb; 1 PROCEDURE WRITERAND(VAR F:TEXT;LOGREC,adr,nbytes:INTEGER); 1 PROCEDURE VECTOR(A,L:REAL); 1 PROCEDURE TURTLE; 1 PROCEDURE TURN(A:REAL); 1 PROCEDURE SecondPass(VAR gfile:TEXT;prn:BOOLEAN); 1 PROCEDURE SETXY(X,Y:REAL); 1 PROCEDURE SETHD(A:REAL); 1 PROCEDURE RIGHT(A:REAL); 1 PROCEDURE PutDIS; 1 PROCEDURE PrintRec(VAR r:rec); 1 PROCEDURE Print; 1 PROCEDURE PLOT(X,Y:INTEGER); 1 PROCEDURE PENUP; 1 PROCEDURE PENDOWN(C:INTEGER); 1 PROCEDURE PAPER(C:INTEGER); 1 PROCEDURE NewFile; 1 PROCEDURE ListData(VAR f:TEXT); 1 PROCEDURE LINE1(X,Y,SX,SY:INTEGER); 1 PROCEDURE LINE(ON:BOOLEAN;X,Y:INTEGER); 1 PROCEDURE LEFT(A:REAL); 1 PROCEDURE KillData; 1 PROCEDURE InsertRec(VAR r:rec); 1 PROCEDURE INK(C:INTEGER); 1 PROCEDURE Help; 1 PROCEDURE GetRec(VAR r:rec); 1 PROCEDURE GetDIS; 1 PROCEDURE Generate; 1 PROCEDURE FirstPass; 1 PROCEDURE FWD(L:REAL); 1 PROCEDURE EnterCommand(f:flag); 1 PROCEDURE Delete; 1 PROCEDURE DataEnter(lo,hi:INTEGER;f:flag); 1 PROCEDURE DUMP(VAR f:TEXT;start,finish:INTEGER); 1 PROCEDURE ConvertRec(LOGREC,nbytes:INTEGER); 1 PROCEDURE COPY; 1 PROCEDURE CHECK(X,Y:INTEGER); 1 PROCEDURE BACK(L:REAL); 1 PROCEDURE ARCR(R:REAL; A:INTEGER); 1 PRIMES PAS 1 Out of RAM 1 Only FILEs OF CHAR or subrange allowed 1 OF SET OF 0..255; 1 Number too large 1 Number is too large 1 Number expected 1 Null strings not allowed: use CHR(0) 1 Null set not allowed here 1 Now converting into ASCTrack-Info 1 Now converting into ASC XCOR,YCOR,HEADING:REAL; 1 No associated WITH statementc 1 No Source File: 1 Nextline INC HL 1 Minimum D option value: 1 Maths Call Error 1 Lowerbound > upperbound 1 Label at wrong level 1 Konfigure list 1 Index too Low 1 Index too High 1 Identifier is not a type 1 Identifier is not a constant 1 Identifier expected 1 IN ['A'..'F'] THEN i:=ORD(f^)-ORD('A')+10 ELSE 1 HiSoft Pascal Tape-to-Disk 1 HiSoft Pascal Tape to Disk Converter 1 HiSoft Pascal Editor 1 HiSoft Pascal +3 version 1 HiSoft Pascal +3 loader 1 Hex digit expected 1 Halt at PC= 1 HPTTD 1 HPE 1 HPC 1 HEX PAS 1 Get from tape 1 Function result must be type i 1 Files must be globals or VAR parameters 1 File not found 1 File buffer too large ( >32K ) 1 File Error 1 Field identifier expected 1 Factor expected 1 FUNCTION inrange(i:INTEGER):BOOLEAN; 1 FUNCTION getaddr:INTEGER; 1 FUNCTION eaddr:INTEGER; 1 FUNCTION READRAND(VAR F:TE%R 1 FUNCTION READHEX(VAR f:TEXT):INTEGER; 1 FUNCTION FindEnd(VAR r1:rec;i:INTEGER):INTEGER; 1 FUNCTION DeleteRec(VAR r:rec):BOOLEAN; 1 FORWARD, LABEL, CONST, TYPE, VAR, BEGIN 1 FOR t:=0 TO w DO Sieve[t]:=[0..249]; 1 Exponent expected in real number 1 Error:No more text 1 End Address: 1 EXTENDED CPC DSK File 1 ETrack-Info 1 Delimiter: 1 David Nutkins, HiSoft. 1 Copyright HiSoft 1988 1 Copyright HiSoft 1983-8 1 Copyright HiSoft 1980-1988 1 Converter for the Spectrum +3 1 Constant expected 1 Compiling 1 Cannot compare expressions of this type 1 Cannot assign or POKE files 1 Cannot POKE sets 1 Can't write this type of expression 1 Can't read this type of variable 1 Can't open file 1 Can't find chain file 1 Can only use equality tests on pointers 1 CPDRead v3.24 1 CONST w=40; {(w+1)*500 gives the number up to which primes are found. 1 CONST tablesize=31; { X*4-1} 1 CONST bytesperline=16; 1 BIRTHDAYPAS 1 BEGIN {Byte} 1 BEGIN {SecondPass} 1 Array too large ( >64K! ) 1 Array index type must be scalar 1 Amend file 1 All rights reserved. 1 ADDR takes a variable parameter 1 ?d^#V###~< 1 ================================= 1 ;Point to beginning of next line after HL. 1 ;Does check for EOF. 1 ; {Byte, Word, Space, Message } 1 69FE Encodbu FOR i:=oldcx TO cx-1 DO WRITE(gfile,ORD(PEEK(codestart+i,CHAR)):2:H); 1 2nd parameter: 1 2Rd:Id2Sd*|b"Td 1 1st parameter: 1 1 September 1988 1 .. finished. 1 +vk|MEMAVAI 1 *+,-./0123456789 1 ']' or ',' expected in ARRAY decl 1 ']' expected 1 '[' expected 1 'TO' or 'DOWNTO' expected 1 'THEN' expected 1 'PROGRAM' expected 1 'OF' expected 1 'END' or ',' expected in RECORD defn 1 'DO' expected 1 'BEGIN' expected 1 '=' not ':=' in constant declarations 1 '=' expected 1 '<' and '>' can't be used with sets 1 ':=' expected 1 '..' or ',' or ']' expected in set 1 '..' expected 1 '..' ete text(Y/N) 1 '.' expected 1 ',' or ']' expected in set 1 ')' expected 1 '(' expected 1 #s#r###s#r 1 ##s#r###s#r 1 "Type INTEGER or REAL expected",0 1 "Loading Pascal Converter.." 1 "Loading Editor .." 1 "Copying Compiler to RAM disk .." 1 "Cannot compare expressions of this type",0 1 "Can't read this 1 " HiSoft Pascal +3 Loader" 1 !jq"_p""p! 1 !ZpF#N#^#~#fo 1 !Gcp+q##N#F#~ 1 !:\*9~"=\> 1 {Skip to the word which contains the next prime} 1 write('Enter filename:'); 1 word:=0;bit:=1; 1 typ:=ch DIV 64; opc:=ch MOD 64; 1 top:=opc DIV 8; bot:=opc MOD 8; 1 top2:=top DIV 2; 1 this line} 1 runstart:=READHEX(dfile); 1 res:=0;i:=0; 1 readln;read(fname); 1 meslegal:=[' '..'~']; 1 mesilleg:=allchars-meslegal; 1 i:=getaddr; 1 i:=eaddr; 1 getfname; 1 getch;lo:=ch; 1 getch;hi:=ch; 1 from start to finish to file f} 1 fname[12]:='G';fname[13]:='E';fname[14]:='N'; 1 fname[12]:='D';fname[13]:='I';fname[14]:='S'; 1 firstdone:=TRUE; 1 firstdone:=FALSE; 1 finish:=READHEX(dfile); 1 enter(getaddr) 1 empty:=FALSE; 1 eaddr:=off+ch+cx+runstart 1 dnext:=dnext-1; 1 dnext:=1; 1 data[dnext].sta:=MAXINT; 1 cur:=start; 1 codestart:=ADDR(infile)+sob; 1 ch:=ORD(PEEK(cx+codestart,CHAR)); 1 ch:=ORD(PEEK(codestart+oldcx+2,CHAR)); 1 allchars:=[CHR(0)..CHR(255)]; 1 YCOR:=NEWY 1 XCOR:=NEWX; 1 WRTrack-Info 1 WRITELN(dfile,runstart:4:H,finish:6:H); 1 WRITELN('W Word data'); 1 WRITELN('S Space data'); 1 WRITELN('R Get .DIS file from disc'); 1 WRITELN('Performing second pass'); 1 WRITELN('Performing first pass'); 1 WRITELN('P Put .DIS file to disc'); 1 WRITELN('M Message Data'); 1 WRITELN('L List disassembly'); 1 WRITELN('H Help'); 1 WRITELN('G Generate dissassembly to disc'); 1 WRITELN('E,X Exit to CP/M'); 1 WRITELN('D Display data areas'); 1 WRITELN('B Byte Data'); 1 WRITE(gfile,'#',ch:2:H) 1 WRITE(2:8); 1 WRITE('Which name to delete ? '); 1 WITH data[dx] DO 1 WHILE r1.n<r.n DO 1 WHILE r.n>r1.n DO 1 WHILE cx>data[dx].sta DO dx:=dx+1; 1 WHILE cur<finish DO 1 WHILE READRAND(f,i,ADDR(r1),rsize) DO NewFile; 1 WHILE NOT(f^ IN ['0'..'9','A'..'F']) DO GET(f); 1 WHILE NOT EOF(dfile) DO 1 UNTIL r.n[1]='}'; 1 UNTIL empty 1 UNTIL cx>finish; 1 UNTIL (com='E') OR (com='X'); 1 Sy=(<={ / 1 Sieve[0]:=Sieve[0]-[0]; 1 SecondPass(gfile,FALSE) 1 SPOUT(CHR(17));SPOUT(CHR( 8)); 1 SPOUT(CHR(16));SPOUT(CHR( C)) 1 SETXY(127,87); 1 SETHD(A); 1 SETHD(0); 1 REWRITE(gfile,fname); 1 REWRITE(dfile,fname); 1 RESET(infile,fname); 1 RESET(f,' BIRTHDAY.DAT'); 1 READLN; READ(r1.n); 1 READHEX:=res 1 POKE(ADDR(F)+4,CHR(1)); { fool the run-time system into thinking its a read file} 1 POKE(ADDR(F)+4,CHR(1)); { fool the run-time system into thinking its a read fid in READ",0 1 PLOT(ROUND(XCOR),ROUND (YCOR)); 1 PENSTATUS:INTEGER; 1 PENSTATUS:=1 1 PENSTATUS:=0; 1 PENDOWN(6) 1 PAPER(1); 1 P+ means output to the printer 1 NEWY:=YCOR+L*SIN(HEADING* 3.1415926/180); 1 NEWX:=XCOR+L*COS(HEADING* 3.1415926/180); 1 ListData(dfile) 1 LINE1(ABS(X),ABS(Y),SGNX, SGNY) 1 LINE(TRUE,ROUND(NEWX) -ROUND(XCOR),ROUND(NEWY)- ROUND(YCOR)); 1 LD B,(HL) 1 JR Findmj 1 INLINE(#FD,#21,#3A,#5C,#DD,#7E,2,#D7) 1 INLINE(#FD,#21,#3A,#5C, #DD,#56,2,#DD,#5E,4,#DD, #46,6,#DD,#4E,8,#CD, 1 INLINE(#FD,#21,#3A,#5C, #DD,#46,2,#DD,#4E,4,#CD, #E5,#22) 1 INLINE(#FD,#21,#3A,#5C, 1 INLINE(#FD, #21, #3A, #5C, #DD, #7E, 2, #D7); 1 IF typ>0 THEN WRITE(gfile,top:0,','); 1 IF r.n=r1.n THEN WRITERAND(f,i,ADDR(r),rsize) 1 IF r.n=r1.n THEN 1 IF inrange(i) THEN WRITE(gfile,'L') ELSE WRITE(gfile,URE idr; 1 IF inrange(i) THEN WRITE(gfile,'L') ELSE WRITE(gfile,'#'); 1 IF inrange(adr) THEN 1 IF indexed THEN cx:=cx-1; 1 IF hi>127 THEN hi:=hi-256; 1 IF hi=-128 THEN getaddr:=#8000+lo 1 IF firstdone THEN GOTO 99; 1 IF dx>1 THEN IF data[dx-1].fin>=cx THEN dx:=dx-1; 1 IF cx>=data[dx].sta THEN dodata 1 IF cx>=data[dx].sta THEN defmod 1 IF cx=enddef THEN dx:=dx+1 1 IF ch>127 THEN off:=-256 ELSE off:=0; 1 IF ch>127 THEN WRITE(gfile,ch-256:0) ELSE WRITE(gfile,'+',ch:0); 1 IF Y<0 THEN SGNY:=-1 ELSE SGNY:=1; 1 IF X<0 THEN SGNX:=-1 ELSE SGNX:=1; 1 IF READRAND(f,i,ADDR(r1),rsize) THEN NewFile; 1 IF EOLN THEN BEGIN cx:=0;secondfin:=finish END 1 IF EOF(infile) THEN 1 IF EOF(f) THEN NewFile; 1 IF EOF(dfile) THEN 1 IF DeleteRec(r1) THEN WRITE(r1.n,' not found'); 1 IF (X>255) OR (X<0) OR (Y>175) OR (Y<0) THEN 1 HEADING:=HEADING+A; 1 HEADING:=A 1 FindEnd:=i; 1 FWDTrack-Info 1 FOR j:=i TO dnext DO data[j]:=data[j+1] 1 FOR i:=0 TO tablesize DO table[i]:=[] ELSE getaddr:=256*hi+lo 1 FOR I:=1 TO A DO 1 ELSE WRITE(gfile,CHR(no+ORD('B'))); 1 DataEnter(READHEX(INPUT),READHEX(INPUT),f) 1 Count:=1; 1 CHECK(X,Y); 1 CHECK(ROUND(X+XCOR), ROUND(Y+YCOR)); 1 CASE no OF 1 CASE a OF 1 CASE Xreg OF 1 CALL Nextline 1 ,<>;=?*[]}{ 1 *ERROR* 1 {Write this priTrack-Info 1 {Delete record from file} 1 you have made a lot of mistakes } 1 use the H (for Help) command and see the procedures in this file. 1 to provide a systems programming tool of pratical use. 1 to disassemble filename.COM 1 then feel free to improve it. } 1 specific and it is not an example of how to program in Pascal 1 so they do not have to be re-entered on subsequent sessions. 1 set up data areas which may be saved to disc (in a .DIS file) 1 res:=res*16+i; 1 reg(bot) 1 rec= RECORD 1 re:= CHR(ENTIER(ByteNo/65536)); 1 r.n:='}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}'; 1 name= ARRAY[1..32] OF CHAR; 1 j:=bit;k:=word; 1 inrange:=(i>=0) AND (i<=finish) 1 in the file RANDREC.PAS. In fact this simple program could be written more 1 in general but it does show how to use the Hisoft Pascal extentions 1 i:=i-runstart; 1 followed by two hexadecimal numbers. For details of the commands 1 efficiently using several ordinary sequential files. } 1 dum:=READRAND(f,i,ADDR(r),rsize); 1 dnext:=dnext+1; 1 disc (as a .GEN file) or screen. 1 data[i]:=cur 1 data[dnext]:=cur; 1 c:=bit+bit+1; 1 addop(top); 1 When compiled use 1 WRITVAR f: TEXT; 1 WRITERAND(f,0,ADDR(r),rsize); 1 WRITELN; 1 WRITELN('(P)rint '); 1 WRITELN('(I)nsert '); 1 WRITELN('(E)xit '); 1 WRITELN('(D)elete '); 1 WRITE('Out of limits'); 1 WITH cur DO 1 WHILE k<=w DO 1 WHILE cur.sta>d{$r,y,l- } 1 WHILE NOT(bit IN Sieve[word]) DO bit:=SUCC(bit); 1 This program lets you disassemble a .COM and interactively 1 Therata[i].sta DO i:=i+1; 1 Some of the techniques used in this program are very machine 1 REWRITE(f,' BIRTHDAY.DAT'); 1 PROCEDTrack-Info 1 Only exit using E or X do not use CTRL CTrack-Info 1 If there is a feature that you dislike or think should be added, 1 IY:WRITE(gfile,'IY') 1 IX:WRITE(gfile,'IX')tch; 1 INLINE(1,0,3,#21,0,#58, #DD,#7E,2,7,7,7,#5F,#7E, #E6,#C7,#B3,#77,#23,#0B, 1 IF word>50 THEN 1 IF r.n[1] <>'}' THEN PrintRec(r); 1 IF opc=#36 THEN WRITE(gfile,'HALT') ELSE 1 IF i<>-1 THEk 1 IF i<>-1 THEN GET(f) 1 IF f^ on in te sieve} 1 IF f^ IN ['0'..'9'] THEN i:=ORD(f^)-ORD('0') ELSE 1 IF ENTIER(ByteNo)>32767 THEN 1 IF Count=max THEN 1 HL:WRITE(gfile,'HL'); 1 For an example of their use see BIRTHDAY.PAS } 1 FWD(R); TURN(1) 1 FOR j:=dnext DOWNTO i DO data[j+1]:=data[j]; 1 FOR i:=1 TO dnext-1 DO 1 ELSE GetDIS; 1 Disassembly may be of all or part of the program and sent to 1 DIS filename.COM 1 Count:=Count+1; 1 Commands are entered in the form of a single letter normally 1 ByteNo:=ROUND(ByteNo- 65536 * ORD(re)); 1 ByteNo:=LOGREC*nbytes; 1 4. Space. Disassembled as DEFS - avoids disassembling junk. 1 3. Word data. Disassembled as DEFW - useful for jump tables etc 1 2. Byte Data. Disassembled as DEFB 1 1. Messages. Disassmbled as DEFM and DEFB 1 #78,#B1,#20,#EE); 1 {Remove multiples of current prime from Sieve} 1 {Insert record in file} 1 {Find next prime} 1 pass1byte; 1 oldcx:=cx;olddx:=dx; 1 ion to .DIS file } 1 indexed:=FALSE; 1 defmod; 1 cx:=oldcx;dx:=olddx; 1 cur:=cur+bytesperline; 1 Xreg:=HL; 1 WRITERAND(f,i,ADDR(r),rsize); 1 WRITELN(gfile); 1 WRITELN(f) 1 WRITE(f,cur:4:H); 1 WHILE r1.n[1]<>'}' DO 1 WHILE empty AND (word<w) DO 1 W(*$L-*) PROGRAM PRIMES;{$O-} 1 READLN; READ(com); 1 IF prn THEN WRITE(gfile,' ') (* CHR(23),CHR(19)) *) ELSE WRITE(gfile,' '); 1 IF prn THEN 1 IF prn AND (cx-oldcx<=4) THEN 1 IF cx MOD 256 IN table[cx DIV 256] THEN WRITE(gfile,'L',runstart+cx:4:H); 1 IF Sieve[word]=[] THEN BEGIN empty:=TRUE;bit:=0 END; 1 FOR j:=i+1 TO FindEnd(r1,i) DO 1 FOR j:=FindEnd(r1,i) DOWNTO i DO 1 END ELSE DeleteRec:=TRUE 1 ELSE WRITE(500*word+c:8); 1 DeleteRec:=FALSE; 1 CASE upper(com) OF 1 CASE data[olddx].drtyp OF 1 BEGIN i:=i+1; dum:=READRAND(f,i,ADDR(r1),rsize); 1 BEGIN i:=i+1; dTrack-Info 1 'P': Print 1 'I': BEGIN GetRec(r); InsertRec(r) END; 1 'E': CLOSE(f); 1 'D': Delete; 1 word,bit:INTEGER; { The current positiRITE(f,' ':3); 1 word,bit:INTEGER; { The current positi 1 typ,top2:0..3; 1 top,bot:0..7; 1 table:ARRAY[0..tablesize] 1 t,c:INTEGER; { Temporary storage for initialise and how many elements to skip} 1 r:rec; 1 r: rec; 1 opc:0..63; 1 legal,meslegal,mesilleg,allchars: SET OF CHAR; 1 k:=k+word*2;j:= 1 j,k:INTEGER; { The current position that we are deleting from the sieve} 1 infile:TEXT[fsize]; 1 i,ch,oldcx,cx,dnext,olddx,dx:INTEGER; 1 gfile: TEXT[gsize]; 1 fname:filename; 1 firstdone,indexed:BOOLEAN; 1 empty : BOOLEAN; { Is the Sieve empty flag} 1 dfile:TEXT; 1 data:ARRAY[1..datasize] OF datarec; 1 cx:=oldcx; 1 com:CHAR; 1 com: CHAR; 1 ch:CHAR; 1 Xreg:(HL,IX,IY); 1 WRITELN; 1 WRITELN(day:10,'/',month:2,'/',year:2); 1 WRITE(gfile,'DEFW '); 1 Sieve[k]:=Sieve[k]-[j]; 1 FOR i:=1 TO 32 DO 1 Count:=0 1 Count:1..max; { Number of primes on this line} 1 BEGIN 1 word:=word+1; 1 sta:=lo-runstart;fin:=hi-runstart;drtyp:=f 1 rsize=38; {the record size : calculated below } 1 low:=(word MOD 2)*500+c; 1 i:=i+1; dum:=READRAND(f,i,ADDR(r1),rsize); 1 high:=word DIV 2; 1 hi:=READHEX(dfile); 1 filename=ARRAY [1..14] OF CHAR; 1 empty:= Sieve[word]=[] 1 datarec=RECORD 1 ch:=PEEK(i,CHAR); 1 WRITE(high:5); 1 WRITE(f,ch) 1 IF n[i]<>CHR(0) THEN WRITE(n[i]); 1 IF low < 100 THEN 1 IF ch>CHR(127) THEN ch:=CHR(ORD(ch)-128); 1 IF ch<' ' THEN ch:='.'; 1 ELSE WRITE(low:3) 1 max=4; {maximum number of primes to be displayed on one line} 1 gsize=1; 1 fsize=64; { X*8 } 1 datasize=30; 1 WRITE(f,' ',ORD(PEEK(i,CHAR)):2:H); 1 WHILE j>249 DO 1 END; 1 table[adr DIV 256]:=table[adr DIV 256] +[adr MOD 256] 1 indexed:=FALSE; 1 getbits; 1 enddef:=data[dx]Track-Info 1 dnext:=1 1 cx:=cx+1; 1 com:=upper(com); 1 adr:=adr-runstart; 1 Xreg:=HL; 1 WRITELN('No file'); 1 WRITE(gfile,';'); 1 WRITE('Run Address ?');runstar 1,3: BEGIN WRITE('Error in DEFW');READLN END; 1 WRITE('End Address ?');READLN;finish:=READHEX(INPUT)-runstart; 1 WITH data[i] DO 1 WHILE (cx<maxcx) AND NOT (cx MOD 256 IN table[cx DIV 256]) 1 VAR i:INTEGER; 1 S: BEGIN legal:=allchars;maxcx:=MAXINT END 1 READLN; 1 READ(com); 1 PROCEDURE dodefb; 1 ND; 1 M: IF PEEK(cx+codestart,CHAR) IN meslegal THEN 1 IF cx>=data[dx].sta THEN 1 IF com IN ['B','K','R','S','W'] THEN firstdone:=FALSE; 1 IF ODD(top) THEN WRITE(gfile,'ADC HL,') 1 GOTO 99; 1 FOR i:=oldcx TO cx-1 DO 1 ELSE pass1byte 1 ELSE BEGIN legal:=allchars;maxcx:=cx+4 END; 1 CASE typ OF 1 CASE top OF 1 CASE drtyp OF 1 CASE com OF 1 7:WRITE(gfile,'M') 1 7:WRITE(gfile,'CP ') 1 7:WRITE(gfile,'A') 1 7:CASE top OF 1 7: WRITE(gfile,'RST #',top*8:2:H) 1 6:WRITE(gfile,'P'); 1 6:WRITE(gfile,'OR '); 1 6:IF indexed THEN Xb ELSE WRITE(gfile,'(HL)'); 1 5:WRITE(gfile,'XOR '); 1 5:WRITE(gfile,'PE'); 1 5:WRITE(gfile,'L'); 1 5:IF ODD(top) THEN 1 5:BEGIN 1 4:WRITE(gfile,'PO'); 1 4:WRITE(gfile,'H'); 1 4:WRITE(gfile,'AND '); 1 3:WRITE(gfile,'SP') 1 3:WRITE(gfile,'SET ') 1 3:WRITE(gfile,'SBC A,'); 1 3:WRITE(gfile,'C'); 1 3:WRITE(gfile,'AF') 1 3:IF ODD(top) THEN 1 3:CASE bot OF 1 3: CASE top OF 1 2:gX;ASE top OF 1 2:WRITE(gfile,'SUB '); 1 2:WRITE(gfile,'RES '); 1 2:WRITE(gfile,'NC'); 1 2:CASE bot OF 1 2:BEGIN 1 2: BEGIN 1 1:WRITE(gfile,'Z'); 1 1:WRITE(gfile,'BIT '); 1 1:WRITE(gfile,'ADC A,'); 1 1:CASE bot OF 1 1,2:r1; 1 0:WRITE(gfile,'ADD A,'); 1 0:CASE top OF 1 0:CASE bot OF 1 0: CASE to 3:WRITE(gfile,'LD A,R'); 1 0: BEGIN 1 'W': EnterCommand(W) 1 'S': EnterCommand(S); 1 'R': GetDIS; 1 'P': PutDIS; 1 'M': EnterCommand(M); 1 'L': SecondPass(OUTPUT,TRUE); 1 'H','?': Help; 1 'G': Generate; 1 'D': ListData(OUTPUT); 1 'B': EnterCommand(B); 1 rhl:=ENTIER(ByteNo-65536) 1 rhl:=ENTIER(ByteNo) 1 rc:=CHR(0); 1 WRITERAND(f,j-1,ADDR(r1),rsize) 1 WRITERAND(f,j+1,ADDR(r1),rsize) 1 WRITE('Enter their data of birth dd/mm/yy ');ELN('Type one of '); 1 WRITE('Enter the person''s name '); READLN; READ(n); 1 USERF(#115); (* DOS WRITE *) 1 USERF(#112); 1 READRAND:= NOT ODD(RAF); 1 READLN; 1 READ(year); 1 READ(month); GET(INPUT); 1 READ(day); GET(INPUT); 1 IF low < 10 THEN WRITE('00',low:1) 1 BEGIN 1 #FD,#CB,#01,#CE, 1 #CD,#AC,#0E,#FD, 1 #CB,#01,#8E,#F3) 1 {for screens of width of 72 or more} 1 W: CASE cx-oldcx OF 1 S: WRITE(gfile,'DEFS ',cx-oldcx:0); 1 M: IF PEEK(codestart+oldcx,CHAR) IN mesilleg THEN dodefb ELSE 1 ELSE BEGIN cx:=READHEX(INPUT)-runstt:=READHEX(INPUT); 1 BEGIN 1 B: dodefb; 1 reg(top); 1 reg(bot) 1 lo:=READHEX(dfile); 1 WRITE(gfile,oldcx+runstart:4:H,' '); 1 WRITE(gfile,'LD '); 1 WRITE(gfile,','); 1 WRITE(gfile,' ') (*CHR(23),CHR(14)) *) 'K': KillData; 1 WRITE(gfile,' ') (*CHR(23),CHR(14)) *) 1 WHILE dfile^=' ' DO GET(dfile); 1 READLN(dfile) 1 READ(dfile,junk); 1 IF cx-oldcx<=4 THEN 1 END 1 ELSE 1 DataEnter(lo,hi,f); 1 CASE dfile^ OF 1 BEGIN k:=k+1;j:=j-250 END 1 3: typ3 1 2: typ2; 1 1: typ1; 1 0: typ0; 1 'W': f:=W 1 'S': f:=S; 1 'M': f:=M; 1 'B': f:=B; 1 WRITE(gfile,'DEFB '); 1 FOR i:=oldcx TO cx-1 DO 1 END; 7: BEGIN WRITE(gfile,'JR C,');e END 1 ELSE WRITE('0',low:2) 1 ELSE BEGIN legal:=mesilleg;maxcx:=cx+4 END; 1 WITH data[dx] DO 1 END 1 END; 1 ITELN('K Kill data area'); 1 END; 1 '#'); 1 reg(top); 1 ch:=ORD(PEEK(codestart+i,CHAR)); 1 cc(top) 1 addop(top); 1 WRITELN(f) 1 WRITE(gfile,CHR(ch)) 1 WRITE(gfile,'RET '); 1 WRITE(gfile,'POP '); qq(top2) 1 WRITE(gfile,'JP '); 1 WRITE(gfile,'INC '); 1 WRITE(gfile,'DEC '); 1 WRITE(gfile,'CALL '); 1 WRITE(f,i,sta+runstart:6:H,fin+runstart:6:H); 1 W: WRITE(f,' Word') 1 S: WRITE(f,' Space'); 1 N 1 M: WRITE(f,' Mess'); 1 IF ch>127 THEN ch:=ch-128; 1 IF ch<32 THEN ch:=ORD('.'); 1 FOR i:=oldcx TO cx-1 DO WRITE(gfile,ORD(PEEK(codestart+i,CHAR)):2:H); 1 CASE top OF 1 CASE drtyp OF 1 BEGIe,'DI'); 1 B: WRITE(f,' Byte'); 1 7:WRITE(gfile,'SRL ') 1 7:WRITE(gfile,'EI') 1 7:WRITE(gfile,'DR') 1 7: WRITE(gfile,'CCF') 1 7: CASE top OF 1 6:getch 1 6:WRITE(gfile,'SLO '); 1 6:WRITE(gfile,'IR'); 1 6:WRITE(gfil: WRITE(gfile,'A,(BC)'); 1 6:CASE top OF 1 6: WRITE(gfile,'SCF'); 1 6: BEGIN r1;getch END 1 6: BEGIN WRITE(gfile,'JR NC,');e END; 1 5:WRITE(gfile,'SRA '); 1 5:WRITE(gfile,'EX DE,HL'); 1 5:WRITE(gfile,'D'); 1 5:IF ODD(top) THEN 1 5:C 0:WRITE(gfile,'NZ'); 1 5: WRITE(gfile,'CPL'); 1 5: BEGIN WRITE(gfile,'JR Z,');e END; 1 4:nn1; 1 4:WRITE(gfile,'SLA '); 1 4:WRITE(gfile,'I'); 1 4:BEGIN WRITE(gfile,'EX (SP),');gX END; 1 4: WRITE(gfile,'DAA'); 1 4: CASE top OF 1 4: BEGIN WRITE(gfile,'JR NZ,');e END; 1 4: BEGIN oneDEFW; WRITE(gfile,','); nn END 1 4,5: r1; 1 3:WRITE(gfile,'RR '); 1 3:BEGIN WRITE(gfile,'IN A,(');n;WRITE(gfile,')') END; 1 3:BEGIN 1 3: WRITE(gfile,'RRA'); 1 3: BEGIN WRITE(gfile,'JR ');e END; 1 2:nn1; 1 2:WRITE(gfile,'RL '); 1 2:BEGIN WRITE(gfile,'OUT (');n;WRITE(gfile,'),A') END; 1 2:BEGIN WRITE(gfile,'IN');idr END; 1 2:BEGIN 1 2: oneDEFW; 1 2: IF top>3 THEN nn1; 1 2: BEGIN WRITE(gfile,'DJNZ ');e END; 1 1:cb; 1 1:WRITE(gfile,'RRC '); 1 1:BEGIN WRITE(gfile,'CP');idr END; 1 1:BEGIN 1 1: WRITE(gfile,'RRCA'); 1 1: WRITE(gfile,'EX AF,AF'''); 1 0:WRITE(gfile,'RLC '); 1 0:BEGIN WRITE(gfile,'LD');idr END; 1 0:BEGIN WRITE(gfile,'JP ');nn END; 1 0:BEGIN 1 0: WRITE(gfile,'RLCA'); 1 0: WRITE(gfile,'NOP'); 1 0: IF top>1 THEN enter(eaddr); 1 n:name; {32 bytes } 1 gX; 1 dd(top2) 1 day,month,year:INTEGER { 6 bytes } 1 WRITE(gfile,'PUSH ');qq(top2) 1 WRITE(gfile,'LD ');dd(top2);WRITE(gfile,',');nn 1 WRITE(gfile,'INC ');dd(top2) 1 WRITE(gfile,'DEC ');dd(top2) 1 WRITE(gfile,'ADD '); 1 WRITE(gfile,','); 1 For each increment of w, 32 bytes of storage are needed} 1 BEGIN legal:=meslegal;maxcx:=MAXINT END 1 AND (cx<enddef) AND (PEEK(cx+codestart,CHAR) IN legal) 1 7: BEGIN WRITE(gfile,'A,');bnn END 1 6: BEGIN bnn;WRITE(gfile,',A') END; 1 5: BEGIN gX;WRITE(gfile,',');bnn END; 1 4: BEGIN bnn;WRITE(gfile,',');gX; END; 1 3:BEGIN WRITE(gfile,'LD SP,'); gX END 1 3: WRITE(gfile,'A,(DE)'); 1 3: BEGIN indexed:=TRUE;Xreg:=IY;byte END 1 2:BEGIN WRITE(gfile,'JP (');gX;WRITE(gfile,')') END; 1 2: ed; 1 2: WRITE(gfile,'(DE),A'); 1 1:WRITE(gfile,'EXX'); 1 1: BEGIN indexed:=TRUE;Xreg:=IX;byte END; 1 1 1 0:WRITE(gfile,'RET'); 1 0: WRITE(gfile,'(BC),A'); 1 0: BEGIN WRITE(gfile,'CALL ');nn END; 1 sta,fin:INTEGER; 1 drtyp:flag 1 END 1 dx:=dx+1 1 dd(top2) 1 cx:=fin+1; 1 WRITE(gfile,'OUT (C),');reg(top) 1 WRITE(gfile,'LD '); 1 WRITE(gfile,'IN ');reg(top);WRITE(gfile,',(C)') 1 WRITE(gfile,'DEFM "'); 1 WRITE(gfile,'"') 1 IF drtyp=W THEN WHILE cx<=fin DO nn1; 1 IF ODD(top) THEN BEGIN dd(top2);WRITE(gfile,',');bnn END 1 FOR i:=oldcx TO cx-1 DO 1 END; 1 END 1 CASE top2 OF 1 secondfin:=READHEX(INPUT)-runstart 1 7:WRITE(gfile,'OTDR') 1 1: IF NOT ODD(top) THEN nn1; 1 WRITE(gfile,PEEK(i+codestart,CHAR)); 1 WRITE(gfile,'#',ORD(PEEK(i+cod 2: WRITE(gfile,'RLA'); 1 IF i>oldcx THEN WRITE(gfile,','); 1 6:WRITE(gfile,'OTIR'); 1 5:WRITE(gfile,'RLD') 1 5:WRITE(gfile,'OUTD'); 1 4:WRITE(gfile,'RRD'); 1 4:WRITE(gfile,'OUTI'); 1 3:WRITE(gfile,'IM 2') 1 2:WRITE(gfile,'LD A,I'); 1 2:WRITE(gfile,'IM 1'); 1 2:BEGIN 1 2,3:getch 1 1:WRITE(gfile,'RETI') 1 1:WRITE(gfile,'LD R,A'); 1 1:BEGIN getbits;r1 END; 1 0:WRITE(gfile,'RETN'); 1 0:WRITE(gfile,'NEG') 1 0:WRITE(gfile,'LD I,A'); 1 0:WRITE(gfile,'IM 0'); 1 DO cx:=cx+1; 1 END 1 1,3:BEGIN indexed:=TRUE;pass1byte END; 1 ELSE WRITE(gfile,'SBC HL,'); 1 ELSE BEGIN bnn;WRITE(gfile,',');dd(top2) END 1 getbits; 1 IF (typ=1) AND (bot=3) THEN nn1; 1